;; In this example, we'll make an address book. Or rather, we'll make
;; a storage backend for an address book. This will be a simple
;; mapping between names and email addresses.

(use-package :cl-gdbm)

;; First, we need functions to get and set people's email
;; addresses. Each of these functions opens up the database each time
;; it is called, rather than doing bulk updates on an already-open
;; database. This is easy, and the performance hit (if any) shouldn't
;; be too large. After all, fine-grained locking is good.
(defun email (filename person-name)
  "Get the email address of a person from a database"
  (with-open-db (db filename :mode :read)
    (getkey db person-name)))

(defun (setf email) (email filename person-name)
  "Set the email address of a person from a database to EMAIL"
  (with-open-db (db filename :mode :write)
    (setf (getkey db person-name) email)))

(defun remove-person (filename person-name)
  "Remove a person from the address book database"
  (with-open-db (db filename :mode :write)
    (delete-key db person-name)))

;; For debugging purposes, we ought to have some way to look at the
;; entire contents of the database. This function will do just that.

(defun address-book-alist (filename)
  "Return the contents of the address book as an alist"
  (with-open-db (db filename :mode :read)
    (db->alist db)))

;; Next, we need to set up a database. Right now, we'll just use a
;; hardcoded database filename. This should be a string or a pathname.

(defvar *database-filename* (merge-pathnames "address-book.gdbm")
  "The pathame for the database file")

;; Let's populate the database.

(mapc #'(lambda (name email)
	  (setf (email *database-filename* name) email))
      '("Larry" "Curly" "Moe" "Peter Scott" "Big Pete")
      '("larry@stooges.net"
	"curly@stooges.net"
	"moe@stooges.net"
	"pjscott@iastate.edu"
	"sketerpot@gmail.com"))

;; We could have done the same thing with the built-in alist->db
;; function, which is good at populating databases:

(with-open-db (db *database-filename* :mode :write)
  (alist->db db '(("Larry" . "larry@stooges.net")
		  ("Curly" . "curly@stooges.net")
		  ("Moe" . "moe@stooges.net")
		  ("Peter Scott" . "pjscott@iastate.edu")
		  ("Big Pete" . "sketerpot@gmail.com"))))

;; Now, let's briefly inspect the contents of the address book:

(address-book-alist *database-filename*)
; =>
; (("Peter Scott" . "pjscott@iastate.edu")
;  ("Big Pete" . "sketerpot@gmail.com")
;  ("Curly" . "curly@stooges.net")
;  ("Larry" . "larry@stooges.net")
;  ("Moe" . "moe@stooges.net"))

;; Everything looks good. Let's try some common operations. First,
;; we'll have Peter Scott change over from <pjscott@iastate.edu> to
;; <pscott@common-lisp.net>.

(setf (email *database-filename* "Peter Scott") "pscott@common-lisp.net")

;; Let's print out Peter Scott's email address in a nice format.

(format t "~&Peter Scott's email address is <~A>.~%"
	(email *database-filename* "Peter Scott"))
; => Peter Scott's email address is <pscott@common-lisp.net>.

;; You can do large-scale database manipulation by iterating over all
;; the keys. Here, we'll change all the email addresses to uppercase.
;; 
;; This will be simpler if we define a utility function. Notice that
;; we can't use the EMAIL and (SETF EMAIL) functions, since those
;; would require recursively opening the database again. That sort of
;; thing is not good. As it is, this performs a nice bulk update.
(defun mapdb (function filename)
  "Map a function to all the entries in the database at FILENAME."
  (with-open-db (db filename :mode :write)
    (dokeys (key db)
      (setf (getkey db key)
	    (funcall function (getkey db key))))))

(mapdb #'string-upcase *database-filename*)

;; Check to make sure it worked:

(email *database-filename* "Moe")	; => "MOE@STOOGES.NET"

;; Success! Now let's change it back, since those email addresses look
;; really ugly in uppercase.

(mapdb #'string-downcase *database-filename*)

;; Let's get rid of "Big Pete".

(remove-person *database-filename* "big Pete")

;; Oops! That gives us a warning saying that no such key exists. And
;; it shouldn't exist, since "big" should be capitalized. Try again:

(remove-person *database-filename* "Big Pete")

;; Now, this is a pretty nice (if crude) address book---but some
;; people have more than one email address. Personally, I have
;; four. Properly, we ought to map names to *lists* of email
;; addresses. That shouldn't be too hard. First, we need to convert
;; our existing data.

(mapdb #'list *database-filename*)

;; If you take a look at the alist, you can see that we've shifted
;; over to storing lists instead of strings. CL-GDBM can store any
;; object that Lisp can print readably.
;;
;; Now that we've shifted our database to a new representation, we can
;; take advantage of it. Let's set Peter Scott' email addresses:

(setf (email *database-filename* "Peter Scott")
      '("sketerpot@gmail.com" "sketerpot@chase3000.com"
	"pscott@common-lisp.net" "pjscott@iastate.edu"))

;; This is really just for entertainment value, but here's a function
;; to pretty-print the address book. The format is plain text, rather
;; than HTML or TeX or something snazzy like that.
(defun pretty-print-address-book (filename &optional (stream *standard-output*))
  (labels ((pretty-print-entry (name emails)
	     (if (= (length emails) 1)
		 (format stream "~&~A: ~A~%" name (first emails))
		 (progn (format stream "~&~A:~%" name)
			(dolist (email emails)
			  (format stream "    ~A~%" email))))))
  (with-open-db (db filename :mode :write)
    (dokeys (key db)
      (pretty-print-entry key (getkey db key))))))

(pretty-print-address-book *database-filename*)